home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1994 December
/
PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin
/
prgmming
/
win
/
pascal
/
xini.pas
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-16
|
10KB
|
358 lines
(*****************************************************************************)
(* *)
(* filename : XINI.PAS *)
(* author : Max Maischein / FidoNet : 2:249/6.17 *)
(* adapted : Stefan Boether / Compuserve Id : 100023,275 *)
(* FidoNet : 2:243/91.331 *)
(* Internet: 100023.275@CompuServe.COM *)
(* system : BP 7.0 *)
(* changes : *)
(* when what who *)
(*---------------------------------------------------------------------------*)
(* 16.01.93 Use the PChar-Type came with BP 7.0 also for DOS Stefc *)
(*****************************************************************************)
(* Description : An object for handling *.INI files ! *)
(*****************************************************************************)
{Header-End}
(*
Notification : The most of the work came from Max !! Many thanks
to him from me. I adapated it to my Xlibary's for
my own suppose, so if you want the original
unit please contact Max not me ! In his original
unit there also is a little more flexible than
my version. But my is smaller because many of
the function he has in his, I've in my own libs !
And I have use the IScan function from the
EDITORS Unit here, so it may be some faster !
If you find some bugs in this source, please
let me know ?
- Mfg Stefc -
*)
UNIT xIni; {$O+,D+,I-}
INTERFACE
USES Dos,
Objects,
Strings;
TYPE PProfile= ^TProfile;
TProfile= object( TObject )
constructor Init( FileName: PathStr; AGroup: String );
destructor Done; virtual;
function GetString ( ItemName:String; Default:String) : String;
procedure WriteString( ItemName:String; Value :String );
function GetInt ( ItemName:String; Default:Integer):Integer;
procedure WriteInt ( ItemName:String; Value :Integer);
private
Changed : Boolean;
TheBuffer : PChar;
TheFile : file;
Group : String;
GroupStart : PChar;
GroupSize : Word;
Function SetGroup( NewGroup : String ) : Boolean;
Procedure CreateGroup( NewGroup : String );
End;
IMPLEMENTATION
const cr = #$0D;
lf = #$0A;
crlf = cr+lf;
{ Thanks to Borland for their fast string search asm procs ! }
const sfSearchFailed = $FFFF;
function IScan(var Block; Size: Word; Str: String): Word; assembler;
var S: String;
asm
PUSH DS
MOV AX,SS
MOV ES,AX
LEA DI,S
LDS SI,Str
XOR AH,AH
LODSB
STOSB
MOV CX,AX
MOV BX,AX
JCXZ @@9
@@1: LODSB
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: STOSB
LOOP @@1
SUB DI,BX
LDS SI,Block
MOV CX,Size
JCXZ @@8
CLD
SUB CX,BX
JB @@8
INC CX
@@4: MOV AH,ES:[DI]
AND AH,$DF
@@5: LODSB
AND AL,$DF
CMP AL,AH
LOOPNE @@5
JNE @@8
DEC SI
MOV DX,CX
MOV CX,BX
@@6: REPE CMPSB
JE @@10
MOV AL,DS:[SI-1]
CMP AL,'a'
JB @@7
CMP AL,'z'
JA @@7
SUB AL,20H
@@7: CMP AL,ES:[DI-1]
JE @@6
SUB CX,BX
ADD SI,CX
ADD DI,CX
INC SI
MOV CX,DX
OR CX,CX
JNE @@4
@@8: XOR AX,AX
JMP @@11
@@9: MOV AX, 1
JMP @@11
@@10: SUB SI,BX
MOV AX,SI
SUB AX,WORD PTR Block
INC AX
@@11: DEC AX
POP DS
end;
{ - Thanks to Freddy Ertl and Ralph Machholz for the following two procs ! }
function Str2PChar(var St:String):PChar;
var i : Integer;
begin
i := Length(St);
Move( St[1], St[0], I );
St[i] := #0;
Str2PChar := PChar(@St);
end;
function PChar2Str(var St:String):String;
var i : Integer;
begin
i := 0 ;
while (St[i] <> #0) do inc(i);
If i > 254 then RunError(255);
Move(St[0],St[1],I);
St[0]:=Chr(i);
PChar2Str := St;
end;
{ - Some stuff came from me ! }
function UpCaseStr( St:String):string;
var I : BYTE;
begin
for I := 1 TO LENGTH( St ) DO
St[I] := UpCase( St[i] );
UpCaseStr := St;
END;
procedure CheckGroup(var NewGroup:String);
begin
If NewGroup[ 1 ] <> '[' then
NewGroup := '[' + NewGroup;
If NewGroup[Length(NewGroup)] <> ']' then
NewGroup := NewGroup + ']';
end;
procedure CheckItem(var ItemName:String);
begin
if ItemName[Length(ItemName)] <> '=' then
ItemName := ItemName + '=';
end;
(************************************************************************)
(* *)
(* Object : TProFile *)
(* *)
(************************************************************************)
constructor TProfile.Init;
const fmDenyWrite = $20;
var TheSize : word;
SavFileMode : Word;
begin
inherited Init;
If Pos( '.',FileName)= 0 then FileName := FileName + '.INI';
SavFileMode := filemode;
filemode := fmDenyWrite; { Other only can read the file !!! }
Assign( TheFile, FileName );
Reset ( TheFile, 1 );
if ioresult <> 0 then begin
rewrite( TheFile, 1 );
if ioresult <> 0 then
fail
else
TheSize := 0;
end else
TheSize := filesize(TheFile);
filemode := SavFilemode;
GetMem( TheBuffer, Succ(TheSize)); { Get enough memory to hold the entire File }
BlockRead( TheFile, TheBuffer^,TheSize);
StrLCopy( TheBuffer,TheBuffer,TheSize);
GroupSize := 0;
GroupStart := TheBuffer;
If not SetGroup( AGroup ) then
CreateGroup( AGroup );
Changed := False;
End;
Destructor TProfile.Done;
Begin
If Changed then begin
ReWrite( TheFile, 1 );
BlockWrite( TheFile, TheBuffer^, StrLen(TheBuffer));
end;
Close( TheFile );
StrDispose(TheBuffer);
inherited Done;
End;
{ - Go to the specific group }
Function TProfile.SetGroup;
Var MyPos : Word;
P : PChar;
Begin
If NewGroup = '' then Begin
GroupStart := TheBuffer;
GroupSize := StrLen(TheBuffer);
SetGroup := True;
Exit; { could be better, but ;-) }
End;
CheckGroup(NewGroup);
MyPos := IScan( TheBuffer^, StrLen(TheBuffer), UpcaseStr(NewGroup));
If MyPos <> sfSearchFailed then Begin
GroupStart := TheBuffer + MyPos;
Group := NewGroup;
P := StrScan( GroupStart+Length(NewGroup), '[' );
If P = nil then
GroupSize := StrLen(GroupStart)
else
GroupSize := P-GroupStart;
SetGroup := True;
End else
SetGroup := False;
End;
{ - Append a new group into the INI-File - }
Procedure TProfile.CreateGroup;
Var NewBuffer : PChar;
Begin
CheckGroup(NewGroup);
NewGroup := NewGroup + CRLF;
GetMem ( NewBuffer, StrLen(TheBuffer)+Length(NewGroup));
StrLCopy( NewBuffer, TheBuffer,StrLen(TheBuffer));
StrCat ( NewBuffer, Str2PChar(NewGroup));
StrDispose(TheBuffer);
TheBuffer := NewBuffer;
PChar2Str(NewGroup);
Delete( NewGroup, Pred(Length(NewGroup)), 2 );
SetGroup(NewGroup);
Changed := True;
End;
{ - Get a string-item from the group }
Function TProfile.GetString;
Var MyPos : Word;
P,Q : PChar;
Tmp : array[0..255] of char;
Begin
GetString := Default;
CheckItem( ItemName );
MyPos := IScan(GroupStart^,GroupSize,UpcaseStr(ItemName));
If MyPos <> sfSearchFailed then begin
Q := GroupStart + (MyPos + Length(ItemName));
P := StrScan(Q, CR );
If P <> nil then
GetString := StrPas(StrLCopy(Tmp,Q,P-Q));